perm filename UNIF[1,JRA] blob sn#005812 filedate 1972-07-04 generic text, type T, neo UTF8
00100	TITLE UNIF
00200	P=14
00300	INTERN SETU,POTZ1,UNIAB,UNIFAB,TTYIN,ORDERP,PMEMQ,STOP
00400	
00500	 EXTERN CONS,FWCONS,FALSE,NUMVAL
00600	 TRUTH=1111
00700	
00800	UNIFAB:	CAMN 1,2
00850		JRST TRUE
00875		MOVE 4,(2)
00900		MOVE 2,(1)
01000	U1:	SETZB 1,3
01100		JUMPE 2,TRUE
01200		JUMPE 4,TRUE
01300		ROTC 1,4
01400		ROTC 3,4
01500		CAMN 1,3
01600		JRST U1
01700		JUMPE 1,U1
01800		JUMPE 3,U1
01900		JRST FALSE
02000	
02100	TRUE:	MOVEI 1,TRUTH
02200		POPJ P,0
02210	STOP:	MOVEI 10,ACS
02220		BLT 10,ACS+17
02222		MOVE 0,120
02224		MOVEM 0,OLDST#
02226		MOVEI 0,STP1
02228		HRRM 0,120
02230		HALT
02232	STP1:	MOVE 0,OLDST
02234		MOVEM 0,120
02240		HRLZI 10,ACS
02250		BLT 10,17
02258	
02260		POPJ P,0
02270	
02280	ACS:	BLOCK 20
02290	
02300	
02400	SETU:	JUMPE 1,FALSE
02450		MOVE 3,1
02500		MOVE 4,1
02600	S1:	HLRZ 2,(3)
02700		HRRZ 1,(2)
02750		PUSH P,2
02800		PUSHJ P,NUMVAL
02850		POP P,2
02900		HRRM 1,(2)
03000		HRRZ 3,(3)
03100		JUMPN 3,S1
03200		MOVE 1,4
03300		POPJ P,0
03400	
03500	POTZ1:	SETZM ,3
03600	P1:	HLRZ 2,(1)
03700		IORM 2,3
03800		ROT 3,-4
03900		HRRZ 1,(1)
04000		JUMPN 1,P1
04100		MOVE 1,3
04200		JRST FWCONS
04300	
04310	TTYIN:	TTCALL 2,1
04320		CLEARM ,1
04330		POPJ P,0
04340	
04350	ORDERP:	CAMG 1,2
04360		CLEARM ,1
04370		POPJ P,0
04380	
04385	UNIAB:	CAMN 1,2
04387		JRST TRUE
04389		MOVE 4,(2)
04392		MOVE 2,(1)
04394	U2:	SETZB 1,3
04396		JUMPE 2,TRUE
04398		JUMPE 4,FALSE
04400		ROTC 3,4
04402		ROTC 1,4
04404		CAMN 3,1
04406		JRST U2
04408		JUMPE 1,U2
04410		JRST FALSE
04412	
04414	PMEMQ:	JUMPE 2,FALSE
04416		MOVE 4,(1)
04418	PM1:	HLRZ 1,(2)
04420		CAMN 4,(1)
04422		POPJ P,0
04424		HRRZ 2,(2)
04426		JUMPE 2,FALSE
04428		JRST PM1
04430	
04432	  END